home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / svgadc30.zip / fontedit.pas < prev    next >
Pascal/Delphi Source File  |  1993-03-03  |  5KB  |  173 lines
  1. program Font_Editor;
  2.  
  3. { This allows you to make your own SVGA fonts however you have   }
  4. { to run the program from TP if you start changing the Width and }
  5. { Height of characters. Click on character you wish to edit.     }
  6. { Use left mouse button to add a pixel, right mouse button to    }
  7. { delete a pixel.  's' to save, 'l' to load CharSetName and      }
  8. { 'q' to quit.                                                   }
  9.  
  10. uses SVGA, Crt;
  11.  
  12. const MaxNumChars = 95;  { Maximum number of Characters }
  13.       Width = 7;
  14.       Height = 9;
  15.       CharSetName = 'standard.chr'; { Name of Character Set file }
  16.   { MAKE SURE THAT WIDTH AND HEIGHT ARE SET FOR THE APPROPRIATE FONT }
  17.   { 'future.chr'    Width = 15  Height = 12  not finished }
  18.   { 'standard.chr'  Width = 7   Height = 9                }
  19.  
  20. type CharType = array[ 0..Width, 0..Height ] of boolean;
  21.      CharSetType = array[ 0..MaxNumChars ] of CharType;
  22.  
  23. var GM : GraphicMouse;
  24.     CharSet : ^CharSetType;
  25.     xx, yy, Btn, Rx, Ry, CutX, CutY : integer;
  26.     PresentChar : byte;
  27.     ReadCh : Char;
  28.     Done : boolean;
  29.  
  30. procedure DrawChar( Ch : integer );
  31.  
  32.   var i, j : integer;
  33.  
  34.   begin
  35.     GM.Show( False );
  36.     Rx := (Ch mod 16)*39+6;
  37.     Ry := (Ch div 16)*39+246;
  38.     Rectangle( Rx, Ry, Rx+27, Ry+27, 252 );
  39.     for i := 0 to Width do
  40.       for j := 0 to Height do
  41.         if CharSet^[Ch][i,j] then
  42.             RectFill( i*9+1, j*9+1, i*9+8, j*9+8, 253 )
  43.         else
  44.             RectFill( i*9+1, j*9+1, i*9+8, j*9+8, 0 );
  45.     GM.Show( True );
  46.   end;
  47.  
  48.  
  49. procedure SetUp;
  50.  
  51.   var i, j, k : integer;
  52.  
  53.   begin
  54.     SetMode( SVGA6448 );
  55.     LoadPalette( 'pal002.pal' );
  56.     for i := 0 to 15 do
  57.       for j := 0 to 5 do
  58.         begin
  59.           Rx := i*39;
  60.           Ry := j*39;
  61.           Rectangle(  Rx , Ry+240, Rx+39, Ry+279, 35 );
  62.           Rectangle( Rx+1, Ry+241, Rx+38, Ry+278, 27 );
  63.           Rectangle( Rx+2, Ry+242, Rx+37, Ry+277, 21 );
  64.           Rectangle( Rx+3, Ry+243, Rx+36, Ry+276, 16 );
  65.           Rectangle( Rx+4, Ry+244, Rx+35, Ry+275, 10 );
  66.         end;
  67.     GetMem( CharSet, (Width+1)*(Height+1)*(MaxNumChars+1));
  68.     for k := 0 to MaxNumChars do
  69.       for i := 0 to Width do
  70.         for j := 0 to Height do
  71.           Charset^[k][i,j] := False;
  72.     PresentChar := 0;
  73.     GM.Initialize;
  74.     DrawChar( PresentChar );
  75.     for i := 0 to Width do
  76.       for j := 0 to Height do
  77.         Rectangle( i*9, j*9, i*9+9, j*9+9, 254);
  78.     Done := False;
  79.     CutX := (Width+1)*9;
  80.     CutY := (Height+1)*9;
  81.   end;
  82.  
  83. procedure FillSquare( A, B : integer; State : boolean );
  84.  
  85.   var s, t, XShift, YShift, Color : integer;
  86.  
  87.   begin
  88.     if State = True then Color := 253
  89.       else Color := 0;
  90.     s := trunc( xx / 9 );
  91.     t := trunc( yy / 9 );
  92.     GM. Show( False );
  93.     RectFill( s*9+1, t*9+1, s*9+8, t*9+8, Color );
  94.     XShift := (PresentChar mod 16)*39+12;
  95.     YShift := (PresentChar div 16)*39+252;
  96.     Plot( XShift+s, YShift+t, Color );
  97.     GM.Show( True );
  98.     CharSet^[PresentChar][s,t] := State;
  99.   end;
  100.  
  101. procedure SaveCharSet;
  102.  
  103.   var i, j, k : integer;
  104.       fil : file of CharSetType;
  105.  
  106.   begin
  107.     GM.Show( False );
  108.     assign( fil, CharSetName );
  109.     rewrite( fil );
  110.     write( fil, Charset^ );
  111.     Close( fil );
  112.     GM.Show( True );
  113.   end;
  114.  
  115. procedure LoadCharSet;
  116.  
  117.   var i, j, k, XShift, YShift : integer;
  118.       fil : file of CharSetType;
  119.       Color : byte;
  120.  
  121.   begin
  122.     GM.Show( False );
  123.     Rx := (PresentChar mod 16)*39+6;
  124.     Ry := (PresentChar div 16)*39+246;
  125.     Rectangle( Rx, Ry, Rx+27, Ry+27, 0 );
  126.     assign( fil,CharSetName );
  127.     reset( fil );
  128.     Read( fil, Charset^ );
  129.     Close( fil );
  130.     for k := 0 to MaxNumChars do
  131.       for i := 0 to Width do
  132.         for j := 0 to Height do
  133.           begin
  134.             XShift := (k mod 16)*39+12;
  135.             YShift := (k div 16)*39+252;
  136.             if CharSet^[k][i,j] then Color := 253
  137.               else Color := 0 ;
  138.             Plot( XShift+i, YShift+j, Color );
  139.           end;
  140.     PresentChar := 0;
  141.     GM.Show( True );
  142.     DrawChar( PresentChar );
  143.   end;
  144.  
  145. begin
  146.   SetUp;
  147.   repeat
  148.     GM.CheckMouse;
  149.     GM.GetPosition( Btn, xx, yy );
  150.     if ( Btn AND $01 = $01 ) AND ( xx < CutX ) AND ( yy < CutY ) then
  151.       FillSquare( xx, yy, True );
  152.     if ( Btn AND $02 = $02 ) AND ( xx < CutX ) AND ( yy < CutY ) then
  153.       FillSquare( xx, yy, False );
  154.     if ( Btn AND $01 = $01 ) AND ( yy > 240 ) then
  155.       begin
  156.         Rx := (PresentChar mod 16)*39+6;
  157.         Ry := (PresentChar div 16)*39+246;
  158.         Rectangle( Rx, Ry, Rx+27, Ry+27, 0 );
  159.         PresentChar := (xx div 39) + ((yy-240) div 39)*16;
  160.         DrawChar( PresentChar );
  161.       end;
  162.     if keypressed = True then
  163.       begin
  164.         ReadCh := ReadKey;
  165.         case ReadCh of
  166.           's','S' : SaveCharSet;
  167.           'l','L' : LoadCharSet;
  168.           'q','Q' : Done := True;
  169.           end;
  170.       end;
  171.   until Done;
  172.   ExitGraphics;
  173. end.